perm filename NEW.FAI[NEW,LCS] blob
sn#647736 filedate 1982-03-09 generic text, type T, neo UTF8
TITLE BMSTF ;0300 SUBROUTINE BMSTF
ENTRY BMSTF
EXTERNAL RHORZ,AMOD,NOZERO,LINES,BMS,MAKNUM,WIDTH ;WIDTH=14.54(10/77)
EXTERNAL .COMM.,ALF,POSI,STF,MIN,BM,PLTR,DL
BMSTF: 0 ;00400 IMPLICIT INTEGER(A-Q,S-Z)
;00500 REAL DIS,DISX,HGT,POS,CENTR,STFF,HGT1
;00600 COMMON/STF/RSTFAC(0/7),RSTJ2/MIN/MINI,RMINI
;00700 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/BM/RA,RC,RJY
;00800 COMMON/POSI/STFF(0/7),JJ2,POS/PLTR/PLT,RHT,DIS
;00900 COMMON/ALF/QQ(3),RST7,RST18,R3Q,JY,RD,RX,RW,RJX,RJ,L,K,
;01000 1 RJA,YY,DISX,HGT,RZ,INP(53)
;01100 EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3))
;01200 1,(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
;01300 1,(J11,JQ(9)),(J6,JQ(4)),(R9,RJQ(7)),(R8,RJQ(6)),(R3,RJQ(1
;01400 1 ,(R7,RJQ(5)),(R4,RJQ(2)),(R9,RJQ(7)),(R10,RJQ(8)),(RX3,R
;01500 DATA R14/14.54/,RTF/3.0/,RHGT/48.0/,R2HGT/96.0/,RBM/.83/
;RDBR IS SPACER FOR DBL BAR. TO COMPENSATE FOR NOTE #3 COMING AT POS=0
MOVE 14,.COMM.+=29 ; J8
JUMPGE 14,BS99 ;IF(J8.GE.0)GO TO BS99
CAMG 14,[-=10] ;IF(J8.LE.-10)GO TO BS99 FOR PARTIAL BEAMS
JRST BS99;**** TYPE R8=-1 OR R9=-1 TO PUT R3 INTO R8 OR R6 INTO R9
MOVE 0,.COMM.+=23 ;GET RX3, UNPROCESSED POS. OF R3
MOVEM .COMM.+11 ;PUT IT IN R8
KIFIX 14,0 ;PUT IT IN J8'S AC
SKIPG 14
MOVEI 14,1 ;MAKE SURE J8 > 0
BS99: SKIPL .COMM.+=30 ; J9
JRST BS100
SKIPG .COMM.+10 ;IF(R7)GO TO BS100 (TREMOLO POS. IN R9)
JRST BS100
MOVE 0,.COMM.+7 ;IF(J9.GE.00)GO TO BS100
MOVEM .COMM.+12 ;PUT IT IN R9
MOVEM 0,.COMM.+=30
BS100: MOVE 13,.COMM.+4 ; 02200 R3Q=R3
MOVE 12,STF+=8 ;2400 C NEXT IS FOR BEAMS
MOVEM 12,MIN+1 ;2500 RMINI=RSTJ2
FMPR 12,[16.092] ;12 IS RX RX=2.7*RSTJ2*5.96
SETZM JRVRS#
MOVE 10,.COMM.+=31 ; 10 IS J10, 13 IS R3Q
JUMPE 10,BS101
CAIGE 10,=10 ;IF(J10.GE.10)IT HAS REVERSED STEM INFO.
JRST BS101
MOVE 2,10 ;JRVRS=J10/10
IDIVI 2,=10 ;1=LENGTHEN LEFT SIDE, 2=RIGHT, 3=BOTH
MOVEM 2,JRVRS
MOVEM 3,.COMM.+=31 ;J10
MOVE 10,3 ;AC10 NOW HAS ONLY 2ND DIGIT OF J10
FLTR 3,3 ;VERT DISPLACEMENT MUST BE LESS THAN 10
MOVEM 3,.COMM.+=11 ;R10
;;; MOVEM 12,RVRS# ;SAVE SIZE OF HORIZ. DISPLACEMENT FOR LATER
BS101: MOVE 5,.COMM.+=10 ; SAVE R9 IN 5
MOVE 6,.COMM.+=28 ; 6 IS J7
;; MOVE .COMM.+5 ;IF(R4.GE.80)R4=R4-100
JSA 16,RHORZ ↔ JUMP .COMM.+7 ;2800 R6=RHORZ(R6)
MOVEM 00,.COMM.+7
;*** MOVSI 2,204500 ; (10.0) IF(R8.NE.0)GO TO 204
;*** JRST BS204 ; IF(R10.GE.10)GO TO 204
;; JUMPE 5,BSJ8 ; IF(J9.EQ.0)GO TO BSJ8 *** NEW***
JUMPGE 14,BSJ8 ; IF(J8.GE.0)GO TO BSJ8 ***NEW***
JUMPE 5,BS91 ↔ MOVN 10,14
;; SETZM .COMM.+=9 ;R8=0
BSJ8: JUMPL 6,BS204 ; 03100 IF(J7)GO TO 204
SKIPN 10 ;IF(J10.NOW IS NE.0)GO TO 204
JUMPG 5,BS1 ; 03200 IF(R9.GT.0)GO TO 1
; R8=0 AND R9=NUM -- PUTS NUMBER OUTSIDE BEAM(FOR TRIPLET
BS204: JUMPE 5,BSR9 ;03400 204 IF(R9.NE.0)R9=RHORZ(R9)
BSX9: JSA 16,RHORZ ↔ JUMP .COMM.+=10
MOVEM 5 ; 5 IS R9
BSR9: JUMPL 6,BS201 ; IF(J7)GO TO 201
;***BS200: CAIGE 10,=10 ; 200 IF(J10.LT.10)GO TO 91
;; JUMPE 10,BS91 ;IF(J10.EQ.0)GO TO 91 NEXT FOR INNER, PARTIAL BEAMS
JUMPE 14,BS1 ;IF(J8.EQ.0)GO TO 1
JUMPLE 14,BSR8 ;IF(J8.LE.0)GO TO BSR8
BSX8: JSA 16,RHORZ ↔ JUMP .COMM.+=9 ;3800 R8=RHORZ(R8)
MOVEM 00,.COMM.+=9
;*** JSA 16,AMOD ; 03900 R10=AMOD(R10,10.)
BSR8: MOVE 02,10 ;J10/10 =0 OR 1 OR 2
IDIVI 02,12 ↔ FLTR 3,3
MOVEM 3,.COMM.+=11 ;R10 NOW = DISPLACEMENT
JUMPN 2,.+3
ADDI 10,12 ;J10=J10+10 CHANGES 1 TO 11, ETC.
JRST BS4 ↔ CAIN 2,2
JRST BS3 ;4100 2 RH=R9+RX
BS2: MOVE 02,12 ↔ FADR 02,5
MOVEM 02,RH# ↔ JRST BS1
BS3: MOVN 02,12 ;4300 3 R8=R9-RX
FADR 02,5
MOVEM 02,.COMM.+=9;10=SHRT PARTIAL LFT↑RT., 20=RT.↑LFT, 30=TO POS IN P8
BS4: MOVE 02,.COMM.+=9 ;4500 4 RH=R8
MOVEM 02,RH ;4600 C LEFT INNER POS.
JRST BS1
BS201: MOVNS 6 ;4800 201 J7=-J7
;4900 C P8=WIDTH OF TREM. P9=0(SANS OTHER BEAMS) OR =POS.3, P10=D
FLTR 0,10 ;5000 CALL NOZERO(R10)
SKIPN
MOVE [1.0] ;ALWAYS AT LEAST 1 IN DISPLACEMENT (AC.0)
MOVEI 10,36 ;05200 J10=30
; TO ACTIVATE PARTIAL BEAM SECTION
MOVE 02,.COMM.+=30 ;5400 IF(J9.NE.0)GO TO 202
JUMPG 02,BS202 ;5500 C NEXT FOR TREM. WITHOUT OTHER BEAMS.
MOVSI 02,576400 ;5600 RH=-1
;**** CAIL 6,24 ;5700 IF(J7.GE.20)RH=-RH
;****** ALL TREM.S GO UP FROM LEFT TO RIGHT NOW ******* MAR. 9, 1982 *******
MOVNS 2 ↔ MOVEM 02,RH
FADR 02,.COMM.+5 ;6000 R5=R4+RH
MOVEM 02,.COMM.+6
MOVE 05,.COMM.+4 ;6100 R9=R3
MOVSI 02,205540 ;6200 R6=R3+22.*RMINI
FMPR 02,MIN+1 ↔ FADR 02,.COMM.+4
MOVEM 02,.COMM.+7
BS202: MOVE 12,.COMM.+=9 ;6300 202 IF(R8.EQ.0)R8=4.
JUMPN 12,.+3
MOVSI 12,203400
MOVEM 12,.COMM.+=9
FMPR 12,MIN+1 ;6400 RX=R8*RMINI*2.98
FMPR 12,[2.98]
MOVE 02,12 ; 06500 RH=R9+RX
FADR 02,5
MOVEM 02,RH
MOVN 02,12 ;6600 R9=R9-RX
FADRM 02,5
JRST BS1 ;6700 GO TO 1
;;BS91: JUMPE 14,BS1 ; 91 IF(J8.EQ.0)GO TO 1
;; JUMPG 14,BS92 ; IF(J8.GT.0)GO TO 92
; FOR J8=-(10+DN) OR -(20+DN) R9=R3+RX
BS91: MOVE 5,.COMM.+4
FADR 5,12 ; IF(J8.LE.-20)R9=R6-RX
CAMLE 14,[-=20] ↔ JRST .+3 ↔ MOVN 5,12
FADR 5,.COMM.+7
BS192: MOVNS 14 ;7400 192 J8=-J8
BS92: JUMPN 10,.+3 ;92 IF(J10.EQ.0)J10=MOD(J8,10)
MOVE 7,14
IDIVI 7,=10 ; IF(J10.EQ.0)J10=1
SKIPN 10
MOVEI 10,1
FLTR 2,10 ;MOVE 2,10 ; R10=J10
MOVEM 2,.COMM.+=11 ;IF P8 NEG, P9 IS AUTOMATIC, ALSO P10 IF NEEDED.
BS1: MOVM .COMM.+=25 ; 08000 1 IF(IABS(J4).LT.100)GO TO 97
CAIGE 00,=80 ↔ JRST BS97
MOVE 02,[0.6] ; 08100 RMINI=.6*RSTJ2
FMPR 02,STF+=8 ↔ MOVEM 02,MIN+1
;; JSA 16,AMOD ;8200 R5=AMOD(R5,100.0)
;; MOVEM 00,.COMM.+6 ; SPACE BETWEEN BEAMS
BS97: MOVSI 2,204540 ;8400 97 RJ=RMINI*11.
FMPR 2,MIN+1
MOVEM 2,ALF+=11
MOVSI 206600 ;MOVE [48.0] ;RW=RMINI*RHGT
FMPR MIN+1
MOVEM ALF+=9 ; DIST. UP OR DOWN FROM NOTE HEAD.
FMPR 2,.COMM.+=11 ;RJA=R10*RJ
MOVEM 2,ALF+=14 ; DISPLACEMENT
MOVEM 5,.COMM.+=10 ; RD=R9
MOVEM 5,ALF+7 ; POSITION 3
FSBR 2,ALF+=9
FADR 02,.COMM.+2 ; RJX=CENTR-RW+RJA
MOVEM 02,ALF+=10 ; FINAL HEIGHT OF LEFT SIDE
; 09300 C NEG R7=TREMOLO
MOVE 11,6
IDIVI 11,=10 ; 09400 RX=MOD(J7,10)
FLTR 12,12 ;FLOAT
MOVEI 1,(6) ; PUT J7 IN 1 FOR NOW
SUBI 6,=20 ;9500 JJ2=J7-20
MOVE 02,.COMM.+7 ; 09600 RA=R6
MOVEM 02,BM ; HORIZANTAL DIST.
MOVSI 3,203700 ; 7.0 RJY=R5*RST7+POS-RST18-RW+RJA
FMPR 03,.COMM.+6 ↔ FSBR 3,[18.0]
FMPR 3,STF+=8 ↔ FADR 3,ALF+=14
FADR 3,POSI+=9 ↔ FSBR 3,ALF+=9
MOVEM 3,BM+2 ; VERTICAL POS OF RIGHT SIDE.
MOVE 4,WIDTH ;10000 RW=R14*RMINI
FMPR 4,MIN+1 ↔ MOVEM 4,ALF+=9
;;; MOVSI 0,202400 ;2.0 10100 RY=1./(RHT*RSTJ2)
;;;;; MOVSI 02,201400 ;*****************8/76
;;; CAMG 0,DL ;IF(RSIZ.GE.2)RY=2./ ....
;;; MOVE 2,0
;;; FDVR 2,DL ;/RSIZ
MOVSI 2,202400 ;2.0 10100 RY=1./(RHT*RSTJ2)
CAMLE 2,DL ;IF(RSIZ.GE.2)RY=2./ ....
MOVSI 2,201400 ;*****************8/76
FDVR 2,DL ;/RSIZ
FDVR 2,STF+=8 ;/RSTJ2
MOVEM 02,RY#
CAIL 1,24 ;200 IF(J7.GE.20)GO TO 98
JRST BS98 ; JUMP IF STEMS ARE DOWN
MOVNS 00,RY ; 10400 RY=-RY
; 10500 C FOR THICKENING INCR.
ADDI 6,=10 ;0600 JJ2=J7-10
MOVNS 00,ALF+=11 ; 10700 RJ=-RJ
MOVE 02,[96.0] ; 10800 RJA=RMINI*R2HGT-2.*RJA
FMPR 02,MIN+1 ↔ MOVE 03,ALF+=14 ↔ FSC 03,1
FSBR 02,3 ↔ MOVEM 02,ALF+=14
FADRM 02,ALF+=10 ; 10900 RJX=RJX+RJA
FADRM 02,BM+2 ; 11000 RJY=RJY+RJA
FADRM 4,13 ; POSITION 1 11100 R3Q=R3Q+RW
FADRM 4,BM ; POSITION 2 11300 RA=RA+RW
FADRM 4,ALF+7 ; 11500 RD=RD+RW
FADRM 4,RH ; 11700 RH=RH+RW
BS98: MOVE 02,[0.83] ; 11800 98 RSTJ2=RSTJ2*RBM
FMPRM 02,STF+=8
; RBM BRINGS LINES OF BEAMS CLOSER TOGETHER. (=.83)
MOVEM 6,POSI+=8 ; JJ2 12000 93 IF(JJ2.GT.RX)GO TO 94
FLTR 6,6 ;FLOAT 6
SKIPN 2,JRVRS ;IF(JRVRS.NE.0)DO NEXT
JRST BSZ9
MOVE ALF+=9 ;HORIZ. SIZE OF A NOTE
CAIGE 1,=20 ;CHECK ON STEM DIR. OF BEAM (J7 IS AC1)
MOVNS ;DISPL=-DISPL IF TO LEFT
CAIN 2,3 ↔ JRST .+3
CAIE 2,1 ;1 PUSH LEFT, 2 PUSH RIGHT, 3=BOTH
JRST BSY9
FADR 13, ;RQ3=RQ3+NT SZ (DISPL)
CAIN 2,1 ;IF 3, THEN DO NEXT ALSO
JRST BSZ9
MOVNS
BSY9: FADRM BM ;CHANGE RIGHT SIDE OF BEAM POS.
BSZ9: CAMLE 6,12
JRST BS94
CAIL 10,=10 ;2100 IF(J10.GE.10)GO TO 7
JRST BS7
;XXX JUMPN 10,BS7 ;IF(J10.NE.0)GO TO 7
; 12200 C**********************
JUMPE 14,BS94 ; IF(J8.EQ.0)GO TO 94
; 12400 R3=RW
MOVE 02,.COMM.+=30 ;12500 IF(J9.EQ.0)GO TO 292
JUMPE 02,BS292
CAIL 14,24 ; IF(J8.GE.20)GO TO 193
JRST BS193
BS293: MOVE 12,13 ; 12700 293 RX=R3Q-RD
FSBR 12,ALF+7
JRST BS194 ; 12800 GO TO 194
BS7: MOVN 4,13 ; 12900 7 RHX=RH-R3Q
FADR 4,ALF+7 ; 13000 R3=RD-R3Q
JRST BS292 ; 13100 GO TO 292
BS193: MOVE 12,ALF+7 ; 13200 193 RX=RD-RA
FSBR 12,BM ; 13300 194 R3=ABS(RX)
BS194: MOVM 4,12 ; 13400 292 DISX=ABS(R3Q-RA)
BS292: MOVE 02,13
FSBR 02,BM
MOVMM 02,ALF+=16 ;13500 HGT=RJX-RJY
MOVE 3,ALF+=10 ↔ FSBR 3,BM+2 ↔ MOVEM 3,HGT#
CAIGE 10,=10 ;3600 IF(J10.GE.10)HGT1=HGT*RHX/DISX
JRST BS10
;XXX JUMPE 10,BS10 ;IF(J10.EQ.0)GO TO 10
MOVN 1,13 ↔ FADR 1,RH ↔ FMPR 1,3
FDVR 1,2 ; 1 HAS -HGT1
BS10: FDVR 4,ALF+=16 ;13800 R3=R3/DISX
MOVEM 4,.COMM.+4 ;13900 195 HGT=HGT*R3
FMPRB 4,HGT ; 14000 196 L=J8/10
SETZM .COMM.+=29 ; 14100 J8=0
CAIL 10,=10 ;14200 IF(J10.GE.10)GO TO 8
JRST BS8
;XXX JUMPN 10,BS8 ;IF(J10.NE.0)GO TO 8
IDIVI 14,=10 ;( L=J8/10)
CAIN 14,1 ; IF(L.EQ.1)GO TO 95
JRST BS95 ;BEAM LFT=1, RT=2 (PARAM 8=10 OR 20)
; 14600 R3Q=RD
MOVE 13,ALF+7 ; 14700 RJX=RJY+HGT
FADR 04,BM+2 ; 4 WAS HGT
MOVEM 04,ALF+=10 ; 14800 GO TO 94
JRST BS94 ; 15000 8 R3Q=RH
BS8: MOVE 13,RH ;15200 RJY=RJX-HGT
MOVE 02,ALF+=10 ↔ FSBR 02,HGT ↔ MOVEM 02,BM+2
FADRM 1,ALF+=10 ;15300 RJX=RJX-HGT1
; 15400 GO TO 94
JRST BS94-2 ; 15500 95 RA=RD
; 15600 RJY=RJX-HGT
BS95: MOVE 02,ALF+=10
FSBR 02,HGT
MOVEM 02,BM+2
MOVE 02,ALF+7
MOVEM 02,BM
BS94: MOVEM 13,ALF+5 ;(R3Q)15700 94 L=7.*RMINI
MOVE 13,PLTR ; AC13 SHOULD NOT BE TAMPERED WITH!
JUMPGE 13,BS930 ;IF(PLT.GE.0)GO TO 930 (SKIP FOR DPY)
MOVSI 02,203740 ; WAS 7.0 (203700)
FMPR 2,MIN+1 ;7.5*RMINI*RSIZ (DL)
FMPR 2,DL ;MAKES CORRECT THICKNESS ON PLOTTER.
KIFIX 0,2 ;JSA 16,IFIX
MOVSI 2,202400 ;IF(RSIZ.GE.2.0)L=L/2 HALF AS MANY LINES.
CAMG 2,DL;ABOVE, THIS, AND BELOW MIGHT BE TAKEN OUT. (WOULD MAKE MORE LINES)
IDIVI 0,2 ;********** 8/76(USE "4", OR MORE, IN VCLIP FOR SOLID BEAMS)
MOVEM 00,ALF+=12 ;15800 930 RC=0
BS930: SETZM BM+1 ;MINI LINES HAVE .2 SMALLER BEAMS. MAYBE CHANGE THIS??
JSA 16,LINES ;16000 CALL LINES(R3Q,RJX,3)
JUMP ALF+5 ↔ JUMP ALF+=10 ↔ JUMP [3] ;16100 DO 941 K=1,L
MOVEI 15,1 ; 16200 CALL BMS
BS12: JSA 16,BMS ;16300 IF(PLT.GE.0)GO TO 940
JUMPGE 13,BS940 ; 16400 RC=RC+RY
MOVE 02,RY
FADRM 02,BM+1 ; FOR THICKENING.
JSA 16,BMS ;16600 CALL BMS
MOVE 1,ALF+5 ; CALL EXCH(RA,ALF+5)
EXCH 1,BM ↔ MOVEM 1,ALF+5 ↔ MOVE 1,ALF+=10
EXCH 1,BM+2 ; 941 CALL EXCH(RJY,RJX)
MOVEM 1,ALF+=10
CAMGE 15,ALF+=12
AOJA 15,BS12 ; 16900 CALL BMS
JSA 16,BMS ; DRAWS 5 LINES FOR BEAMS.
; 17100 940 JJ2=JJ2-1
BS940: SOSG POSI+=8 ; 17200 IF(JJ2.LE.0)GO TO 942
JRST BS942 ; IF P7=10 OR 20 ONE BEAM WILL APPEAR.
MOVE 02,ALF+=11 ; 17400 RJY=RJY+RJ
FADRM 02,BM+2 ; 17500 RJX=RJX+RJ
FADRM 02,ALF+=10
JRST BS930 ;17600 GO TO 930
BS942: SKIPN 14 ;17800 942 IF(J8.NE.0)RETURN
SKIPG .COMM.+=30
JRA 16,(16) ;17900 IF(J9.LE.0)RETURN
MOVSI 02,205740 ;18000 IF(R10.GE.30)RETURN
SKIPL .COMM.+=28 ;IF(J7.LT.0)RETURN
CAMG 02,.COMM.+=11
JRA 16,(16) ; C FOR NUMBERS OUTSIDE BEAMS
;;; MOVE 02,MIN+1 ;18200 RSTJ2=RMINI
;;; MOVEM 02,STF+=8
MOVN 3,[10.0] ;18300 RD=-10.
MOVSI 02,205500 ;18400 IF(R7.LT.20)RD=8.3
CAMLE 02,.COMM.+=8 ↔ MOVE 3,[8.3]
;;; FMPR 3,MIN+1 ;RD=RD*RMINI
MOVN 02,ALF+5 ;18500 943 J3=R3Q+(RA-R3Q)/2.
;;BS943: MOVN 02,ALF+5 ;18500 943 J3=R3Q+(RA-R3Q)/2.
FADR 02,BM ↔ FSC 02,777777 ↔ FADR 02,ALF+5
KIFIX 0,2 ;FIX IT
MOVEM 00,.COMM.+=24 ;18600 R6=1. * RMINI
MOVSI 2,200700 ;*** R6 NOW = 0.875 (SIZE OF NUM.)
MOVE .COMM.+=25 ↔ CAIGE =80 ↔ JRST BS943 ;IF(J4.LT.80)LGO TO 943
FMPR 3,[0.7] ;RD=RD*.06
SKIPL 3 ↔ FSBR 3,[0.83] ;IF(RD)RD=RD-.83
MOVE 2,[0.6] ; R6=0.6
MOVE STF+8 ↔ FDVR [0.83] ↔ SKIPA ;RSTJ2=RSTJ2/.83
BS943: MOVE MIN+1 ↔ MOVEM STF+8 ; RSTJ2=RMINI
MOVEM 02,.COMM.+7 ;18900 R7=1
MOVSI 02,201400
MOVEM 02,.COMM.+=8 ; C ITALICS
MOVE 02,.COMM.+6 ;18800 R4=R4+(R5-R4)/2.+RD
FSBR 02,.COMM.+5 ↔ FSC 02,777777 ↔ FADR 2,3
FADRM 02,.COMM.+5 ↔ SETZM .COMM.+=12 ; R11=0
JSA 16,MAKNUM ;19100 CALL MAKNUM(R9)
JUMP .COMM.+=10 ↔ JRA 16,(16) ; 19300 END
END